\ String Objects Ham 12:00 11/01/92 \ Screens 1 through 11 define $GETC just as in ANSWERS.SCR, \ but without using the variables for REGULAR, SPECIAL, and \ LEGALKEYS. You may want to revise this $GETC to use the \ vectors. \ Screens 12 and 13 define the defining word CHARACTER. Its \ children collect strings, present strings for revision, and \ display strings, each action governed by an action code. \ Screens 14 and 15 show CHARACTER in action. \ 1 LOAD will define CHARACTER and exercise it. \ You can INCLUDE this file in your programs, but first you \ should delete the last line in screen 1 (the THRU phrase) \ and delete screens 14 and 15 (the examples). \ $GET sequence OFFSET LEFTMOST? etc. Ham 12:00 11/01/92 0 EQU CHARS \ maximum number of characters to collect 0 EQU STRING \ address of first byte of string storage \ (past the count byte if any) 0 EQU X \ x-coordinate (col) of original cursor locn 0 EQU Y \ y-coordinate (row) of original cursor locn VARIABLE FIRST \ true after first character in last position : OFFSET ( - n ) ?XY DROP X - ; \ current offset into string : LEFTMOST? ( - flag ) OFFSET 0= ; \ true = left end : RIGHTMOST? ( - flag ) OFFSET CHARS 1- = ; \ true = right end 2 ?SCREENS THRU \ delete this line to use file with INCLUDE \ BACK BELL LEFT RIGHT Ham 12:00 11/01/92 : BACK 8 EMIT FIRST OFF ; VARIABLE NOISE \ true means sound bell NOISE ON \ default : BELL NOISE @ IF 440 20 BEEP THEN ; : LEFT LEFTMOST? IF BELL ELSE BACK THEN ; : RIGHT RIGHTMOST? IF BELL ELSE ?XY SWAP 1+ SWAP GOTOXY THEN ; \ CURSOR INS PCKEY Ham 12:00 11/01/92 : BIGCUR 0 14 SET-CUR ; \ block cursor for insert mode : SMLCUR 6 7 SET-CUR ; \ line cursor for overtype mode : NOCUR 14 0 SET-CUR ; \ no cursor for menu selection VARIABLE INS? \ true if insert mode : CURSOR INS? @ IF BIGCUR ELSE SMLCUR THEN ; : INS INS? @ 0= INS? ! CURSOR ; \ toggle INS? & reset cursr : PCKEY ( -- ASCII-char -1 | IBM-special_char 0 ) KEY ?DUP IF TRUE ELSE KEY FALSE THEN ; \ HOME SETUP OVERTYPE Ham 12:00 11/01/92 : HOME X Y GOTOXY FIRST OFF ; \ go to start of field : SETUP ( adr cnt - ) EQU CHARS EQU STRING ?XY EQU Y EQU X STRING CHARS TYPE CURSOR HOME ; : OVERTYPE ( c - ) RIGHTMOST? SWAP ( save the flag for later ) DUP STRING OFFSET + C! EMIT IF ( rightmost ) FIRST @ IF BELL THEN BACK FIRST ON THEN ; \ PULL PUSH Ham 12:00 11/01/92 : PULL STRING OFFSET + \ current loc in string: destination DUP 1+ \ 1st char past current loc: source SWAP \ put source and dest in order CHARS OFFSET - \ # of chars from cursor to right 1- \ # of chars strictly right of cursor CMOVE \ copy chars BL STRING CHARS 1- + C! ; \ & blank out char at end : PUSH STRING OFFSET + \ current location in string DUP 1+ \ 1st char past current location CHARS OFFSET - \ # of chars from cursor to right 1- \ # of chars strictly right of cursor CMOVE> ; \ copy characters from right \ TAIL END REFRESH DELETE BACKSPACE Ham 12:00 11/01/92 : TAIL ( - offset ) \ leave offset for END: 1 past last char STRING CHARS -TRAILING NIP CHARS 1- MIN ; : END X TAIL + Y GOTOXY ; : REFRESH ?XY OFFSET DUP STRING + ( adr ) CHARS ROT - ( # of char ) TYPE GOTOXY ; \ x & y coordinates can be put on the stack until needed. : DELETE TAIL 1- OFFSET < IF LEFTMOST? NOT IF BACK THEN THEN PULL REFRESH FIRST OFF ; : BACKSPACE LEFTMOST? IF BELL ELSE BACK DELETE THEN ; \ BACKSPACE INSERT LEGAL? Ham 12:00 11/01/92 : PUSHED? ( - f ) STRING CHARS 1- + C@ BL <> ; \ true if a last character is nonblank & thus pushed off end : INSERT ( c - ) RIGHTMOST? IF FIRST @ NOT PUSHED? AND IF BELL THEN OVERTYPE ELSE PUSHED? IF BELL ( character pushed off ) THEN PUSH STRING OFFSET + C! REFRESH RIGHT THEN ; : LEGAL? ( c - flag ) DUP 31 > SWAP 127 < AND ; \ leave true flag for characters from blank through ~ \ Key equivalence constants Ham 12:00 11/01/92 \ The following constants will be generally useful 71 CONSTANT HOMEKEY 82 CONSTANT INSKEY 79 CONSTANT ENDKEY 83 CONSTANT DELKEY 75 CONSTANT LEFTKEY 72 CONSTANT UPKEY 77 CONSTANT RIGHTKEY 80 CONSTANT DOWNKEY 59 CONSTANT F1KEY 81 CONSTANT PGDNKEY 15 CONSTANT LTABKEY 73 CONSTANT PGUPKEY 9 CONSTANT TABKEY 27 CONSTANT ESCKEY 13 CONSTANT ENTERKEY 8 CONSTANT BSPKEY \ TABKEY, ESCKEY, ENTERKEY, and BSPKEY are all ASCII values. \ Others are "special" IBM keys \ REGULAR SPECIAL Ham 12:00 11/01/92 : REGULAR ( c - flag ) DUP LEGAL? IF INS? @ IF INSERT ELSE OVERTYPE THEN FALSE ELSE CASE BSPKEY OF BACKSPACE FALSE ENDOF ENTERKEY OF TRUE ( quits ) ENDOF BELL FALSE SWAP ENDCASE THEN ; : SPECIAL ( c - 0 ) CASE HOMEKEY OF HOME ENDOF LEFTKEY OF LEFT ENDOF RIGHTKEY OF RIGHT ENDOF DELKEY OF DELETE ENDOF INSKEY OF INS ENDOF ENDKEY OF END ENDOF BELL ENDCASE FALSE ; \ $GET $GETC Ham 12:00 11/01/92 : $GET ( adr count - ) REVERSE SETUP BEGIN PCKEY IF ( regular key ) REGULAR ELSE ( special key ) SPECIAL THEN UNTIL -REVERSE ; : $GETC ( adr count - ) \ assume count byte is at STRING - 1 $GET CHARS STRING 1- C! ; \ $GETC stores the maximum string count; trailing blanks can \ easily be trimmed with -TRAILING. \ Defining word for CHARACTER objects Ham 12:00 11/01/92 0 EQU ACTION \ code for action : MEANS ( n - ; name ) CREATE C, DOES> C@ EQU ACTION ; \ defining words for actions 1 MEANS COLLECT \ blank the string and collect new data 2 MEANS REVIEW \ display string and collect revisions 3 MEANS DISPLAY \ display string 4 MEANS $ADDRESS \ leave on stack address of string count byte \ CHARACTER -- defining word for strings Ham 12:00 11/01/92 : CHARACTER ( n - ) \ defining word for string words CREATE DUP C, HERE SWAP DUP ALLOT BLANK \ create header, store char count, initialize area DOES> ( <adr> - ) COUNT ACTION CASE 1 OF ( collect ) 2DUP BLANK $GETC ENDOF 2 OF ( review ) ?XY 2OVER TYPE GOTOXY $GETC ENDOF 3 OF ( display ) -TRAILING TYPE ENDOF 4 OF ( address ) DROP 1- ENDOF CR ." Invalid action code = " . ABORT ENDCASE ; \ Examples: delete screen for INCLUDE Ham 12:00 11/01/92 20 CHARACTER NAME 30 CHARACTER ADDRESS 20 CHARACTER CITY COLLECT CR CR .( Enter name ) NAME CR .( Enter address ) ADDRESS CR .( Enter city ) CITY REVIEW CR CR .( Revise name ) NAME CR .( Revise address ) ADDRESS CR .( Revise city ) CITY \ Examples concluded: delete for INCLUDE Ham 12:00 11/01/92 DISPLAY CR CR .( Name ) NAME CR .( Address ) ADDRESS CR .( City ) CITY $ADDRESS CR CR .( Name address ) NAME U. CR .( Address address ) ADDRESS U. CR .( City address ) CITY U. CR
